home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / f1ocx / vcform1.3 / VB4 / TIMING1 / FOTIME1.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-09-15  |  12.5 KB  |  542 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. Declare Function GetTickCount Lib "kernel32" () As Long
  5.  
  6. Global Const Op_FillF = 0
  7. Global Const Op_FillN = 1
  8. Global Const Op_Calc = 2
  9. Global Const Op_Scroll = 3
  10. Global Const Op_LoadW = 4
  11. Global Const Op_LoadA = 5
  12. Global Const Op_Save = 6
  13. Global Const Op_Copy = 7
  14. Global Const Op_Insert = 8
  15. Global Const Op_Delete = 9
  16. Global Const Op_Sort = 10
  17.  
  18.  
  19. ' Current settings for the timing operations
  20. Global Set_FillRows%
  21. Global Set_FillCols%
  22. Global Set_CalcRows%
  23. Global Set_CalcCols%
  24. Global Set_CopyRows%
  25. Global Set_InsertRows%
  26. Global Set_DeleteRows%
  27. Global Set_ScrollRows%
  28. Global Set_SortRows%
  29.  
  30.  
  31. ' These are the defaults for the timing operations
  32. Global Const DefFillRows = 100
  33. Global Const DefFillCols = 50
  34. Global Const DefCalcRows = 1000
  35. Global Const DefCalcCols = 50
  36. Global Const DefCopyRows = 10000
  37. Global Const DefInsertRows = 10000
  38. Global Const DefDeleteRows = 10000
  39. Global Const DefScrollRows = 10000
  40. Global Const DefSortRows = 10000
  41.  
  42. Global Global_Time_VTI#
  43.  
  44.  
  45.  
  46. Sub CalcTime()
  47.  
  48.     ' Calculates the amount of time it takes to recalc
  49.     
  50.     Dim TheRow%, TheCol%
  51.     Dim RandNum#, BigNum#
  52.     
  53.     ' Fill Worksheet
  54.     
  55.      ' Clear the worksheet and display how many formulas
  56.     Call ClearAll
  57.     BigNum# = CDbl(Set_CalcRows) * CDbl(Set_CalcCols)
  58.     Form1.Results.Caption = "Recalculate " + Format$(BigNum, "##,##0") + " Formulas"
  59.     Form1.Refresh
  60.     
  61.     Form1.MousePointer = 11 ' Hourglass
  62.     
  63.     ' Turn recalc off while we fill the worksheet
  64.     Form1.F1Book1.AutoRecalc = False
  65.  
  66.     ' Put a random number in A1
  67.     Form1.F1Book1.Row = 1
  68.     Form1.F1Book1.Col = 1
  69.     Form1.F1Book1.Number = Int(Rnd(1) * 1000)
  70.     Form1.F1Book1.NumberFormat = "###0.00"
  71.     
  72.     ' Put formulas in the rest of Row 1
  73.     If Set_CalcCols > 1 Then
  74.         Form1.F1Book1.Row = 1
  75.         Form1.F1Book1.Col = 2
  76.         Form1.F1Book1.Formula = "A1+1"
  77.         Form1.F1Book1.NumberFormat = "###0.00"
  78.         Form1.F1Book1.SetSelection 1, 2, 1, Set_CalcCols
  79.         Form1.F1Book1.EditCopyRight
  80.     End If
  81.     
  82.     ' Put all formulas in Row 2
  83.     If Set_CalcRows > 1 Then
  84.         Form1.F1Book1.Row = 2
  85.         Form1.F1Book1.Col = 1
  86.         Form1.F1Book1.Formula = "A1+1"
  87.         Form1.F1Book1.NumberFormat = "###0.00"
  88.         If Set_CalcCols > 1 Then
  89.             Form1.F1Book1.Col = 2
  90.             Form1.F1Book1.Formula = "A2+1"
  91.             Form1.F1Book1.SetSelection 2, 2, 2, Set_CalcCols
  92.             Form1.F1Book1.EditCopyRight
  93.         End If
  94.     
  95.         ' Copy Row 2 down to fill the worksheet
  96.         Form1.F1Book1.SetSelection 2, 1, Set_CalcRows - 2, Set_CalcCols
  97.         Form1.F1Book1.EditCopyDown
  98.     End If
  99.     
  100.     'Recalc back on to recalc all the formulas
  101.     Form1.F1Book1.AutoRecalc = True
  102.     
  103.     ' Restore Mouse Pointer
  104.     Form1.MousePointer = 0
  105.     
  106.     'Set up Formula One for recalc test
  107.     Form1.F1Book1.AutoRecalc = False
  108.     Form1.F1Book1.Row = 1
  109.     Form1.F1Book1.Col = 1
  110.     Form1.F1Book1.Number = Int(Rnd(1) * 1000)
  111.     
  112.     Call Time_Operation(Op_Calc) ' Time both products
  113.  
  114. End Sub
  115.  
  116. Sub ClearAll()
  117.  
  118.     Dim sserror%
  119.     
  120.     ' Clear Formula One
  121.     Form1.F1Book1.SetSelection -1, -1, 0, 0
  122.     Form1.F1Book1.EditClear 1
  123.     Form1.VTSTimeRaw = ""
  124.     Form1.Refresh
  125.  
  126. End Sub
  127.  
  128. Sub CopyData()
  129.  
  130.     Dim sserror%
  131.     
  132.     Call ClearAll
  133.     Form1.Results.Caption = "Copy" + Format$(Set_CopyRows, " ##,###") + " Rows"
  134.     Form1.Refresh
  135.     
  136.     
  137.     ' Fill Formula One
  138.     
  139.     Form1.F1Book1.Row = 1
  140.     Form1.F1Book1.Col = 1
  141.     Form1.F1Book1.TEXT = "Copy..."
  142.     Form1.F1Book1.Col = 2
  143.     Form1.F1Book1.TEXT = "Test..."
  144.  
  145.     Form1.F1Book1.Col = 3
  146.     Form1.F1Book1.NumberFormat = "###0.00"
  147.     Form1.F1Book1.Number = 1234.56
  148.        
  149.     Form1.F1Book1.Col = 4
  150.     Form1.F1Book1.NumberFormat = "###0.00"
  151.     Form1.F1Book1.Formula = "C1+1"
  152.        
  153.     Form1.F1Book1.Col = 5
  154.     Form1.F1Book1.NumberFormat = "###0.00"
  155.     Form1.F1Book1.Formula = "D1+1"
  156.     
  157.     Form1.F1Book1.AutoRecalc = False
  158.     
  159.     Call Time_Operation(Op_Copy)
  160.     Form1.F1Book1.AutoRecalc = True
  161.     
  162. End Sub
  163.  
  164.  
  165.  
  166. Sub Delete_VTI()
  167.  
  168.     Dim sserror%, i%
  169.     
  170.     ' Delete the specified number of rows
  171.     Form1.F1Book1.SetSelection 1, -1, Set_DeleteRows, 256
  172.     Form1.F1Book1.EditDelete F1ShiftVertical
  173.  
  174. End Sub
  175.  
  176. Sub DeleteRows()
  177.  
  178.     Call ClearAll
  179.     Form1.Results.Caption = "Delete " + Format$(Set_DeleteRows, "##,##0") + " Rows"
  180.     Form1.Refresh
  181.     
  182.     Form1.MousePointer = 11
  183.     
  184.     Call Dummy_Data(Set_DeleteRows)
  185.     
  186.     Form1.Refresh
  187.     Form1.MousePointer = 0
  188.     
  189.     Call Time_Operation(Op_Delete) ' Time
  190.  
  191. End Sub
  192.  
  193. Sub Dummy_Data(DummyRows%)
  194.  
  195.     ' Fill Formula One
  196.  
  197.     Form1.F1Book1.AutoRecalc = True
  198.     
  199.     Form1.F1Book1.Row = 1
  200.     Form1.F1Book1.Col = 1
  201.     Form1.F1Book1.TEXT = "VCI..."
  202.     Form1.F1Book1.Col = 2
  203.     Form1.F1Book1.TEXT = "Test..."
  204.  
  205.     Form1.F1Book1.Col = 3
  206.     Form1.F1Book1.NumberFormat = "###0.00"
  207.     Form1.F1Book1.Number = 1
  208.  
  209.     Form1.F1Book1.Col = 4
  210.     Form1.F1Book1.NumberFormat = "###0.00"
  211.     Form1.F1Book1.Formula = "C1+1"
  212.  
  213.     Form1.F1Book1.Col = 5
  214.     Form1.F1Book1.NumberFormat = "###0.00"
  215.     Form1.F1Book1.Formula = "D1+1"
  216.  
  217.     Form1.F1Book1.AutoRecalc = False
  218.  
  219.     Form1.F1Book1.SetSelection 1, 1, DummyRows - 1, 5
  220.     Form1.F1Book1.EditCopyDown
  221.     
  222.     Form1.F1Book1.AutoRecalc = True
  223.  
  224. End Sub
  225.  
  226. Sub Fill_VTI(FillType As Integer)
  227.  
  228.     Dim TheRow%, TheCol%
  229.     
  230.     Form1.F1Book1.AutoRecalc = False
  231.     
  232.     For TheRow = Set_FillRows To 1 Step -1
  233.         For TheCol = Set_FillCols To 1 Step -1
  234.             
  235.             If FillType = 1 Then   ' Formulas
  236.                Form1.F1Book1.FormulaRC(TheRow, TheCol) = "A1+1"
  237.             Else                   ' Numbers
  238.                Form1.F1Book1.NumberRC(TheRow, TheCol) = 12345
  239.             End If
  240.     
  241.         Next TheCol
  242.     Next TheRow
  243.     
  244.     Form1.F1Book1.AutoRecalc = True
  245.     
  246.     If FillType = 1 Then   ' Recalculate if Formulas
  247.        Form1.F1Book1.Row = 1
  248.        Form1.F1Book1.Col = 1
  249.        Form1.F1Book1.Number = 1
  250.        Form1.F1Book1.Recalc
  251.     End If
  252.  
  253. End Sub
  254.  
  255. Sub FillTimeF()
  256.  
  257.     Call ClearAll
  258.     Form1.Results.Caption = "Fill With" + Format$(Set_FillRows * Set_FillCols, " ##,##0") + " Formulas"
  259.     Form1.Refresh
  260.     
  261.     Call Time_Operation(Op_FillF)
  262.  
  263. End Sub
  264.  
  265.  
  266. Sub FillTimeN()
  267.  
  268.     Call ClearAll
  269.     Form1.Results.Caption = "Fill With" + Format$(Set_FillRows * Set_FillCols, " ##,##0") + " Numbers"
  270.     Form1.Refresh
  271.     
  272.     Call Time_Operation(Op_FillN)
  273.  
  274. End Sub
  275.  
  276. Sub Insert_VTI()
  277.  
  278.     Dim sserror%, i%
  279.     
  280.     ' Insert specified number of rows
  281.     Form1.F1Book1.SetSelection 1, -1, Set_InsertRows, 256
  282.     Form1.F1Book1.EditInsert F1ShiftVertical
  283.  
  284. End Sub
  285.  
  286. Sub InsertRows()
  287.  
  288.     Call ClearAll
  289.     Form1.Results.Caption = "Insert " + Format$(Set_InsertRows, "##,##0") + " Rows"
  290.     Form1.Refresh
  291.     
  292.     Form1.MousePointer = 11 ' Hourglass pointer
  293.         
  294.     Call Dummy_Data(10) ' Put in 10 dummy rows
  295.     Form1.Refresh
  296.     
  297.     Form1.MousePointer = 0
  298.     
  299.     Call Time_Operation(Op_Insert) ' Time FO
  300.  
  301. End Sub
  302.  
  303. Sub Load_AVTI()
  304.  
  305.     Dim SSName$
  306.     Dim ReadFileType%
  307.     
  308.     ' Load the ascii file
  309.     SSName$ = App.Path + "\FOTime1.txt"
  310.     Form1.F1Book1.Read SSName$, ReadFileType
  311.  
  312.     Form1.F1Book1.TopRow = 1
  313.     Form1.F1Book1.LeftCol = 1
  314.  
  315. End Sub
  316.  
  317. Sub Load_VTI()
  318.  
  319.  
  320.     Dim SSName$
  321.     Dim ReadFileType%
  322.     
  323.     SSName$ = App.Path + "\FOTime1.vts"
  324.     Form1.F1Book1.Read SSName$, ReadFileType
  325.     
  326.     Form1.F1Book1.TopRow = 1
  327.     Form1.F1Book1.LeftCol = 1
  328.  
  329. End Sub
  330.  
  331. Sub LoadAscii()
  332.  
  333.     Dim SSName$
  334.     Dim AsciiLoadRows%
  335.  
  336.     AsciiLoadRows = 1000 ' 1000 Rows of Ascii Data
  337.  
  338.     Call ClearAll
  339.     Form1.Results.Caption = "Load " + Format$(AsciiLoadRows, "##,##0") + " Row Ascii File"
  340.     Form1.Refresh
  341.  
  342.     Form1.MousePointer = 11 ' Houseglass mouse pointer
  343.  
  344.     Call Dummy_Data(AsciiLoadRows) ' 1,000 rows of dummy data to save
  345.     Form1.Refresh
  346.     
  347.     ' Save the ascii data to a file
  348.     SSName$ = App.Path + "\FOTime1.txt"
  349.     Form1.F1Book1.Write SSName$, F1FileTabbedText
  350.     
  351.     Form1.MousePointer = 0 ' Normal mouse pointer
  352.     
  353.     Call Time_Operation(Op_LoadA) ' Time the load process
  354.  
  355. End Sub
  356.  
  357. Sub LoadFile()
  358.  
  359.     Dim SSName$
  360.     Dim WorksheetRows%
  361.  
  362.     WorksheetRows = 1000 ' Load 1000 row worksheet
  363.     
  364.     Call ClearAll
  365.     Form1.Results.Caption = "Load " + Format$(WorksheetRows, "##,##0") + " Row Worksheet"
  366.     Form1.Refresh
  367.     
  368.     ' Create some dummy data
  369.     Form1.MousePointer = 11 ' Houseglass mouse pointer
  370.  
  371.     Call Dummy_Data(1000) ' 1,000 rows of dummy data to save then load
  372.     Form1.Refresh
  373.  
  374.     ' Save a worksheet
  375.     SSName$ = App.Path + "\FOTime1.vts"
  376.     Form1.F1Book1.Write SSName$, F1FileExcel5
  377.     
  378.     Form1.MousePointer = 0 ' Normal mouse pointer
  379.     
  380.     Call ClearAll
  381.     Call Time_Operation(Op_LoadW) ' Time the load operation
  382.  
  383. End Sub
  384.  
  385. Sub Save_VTI()
  386.  
  387.     Dim SSName$
  388.     
  389.     SSName$ = App.Path + "\FOTime2.vts"
  390.     
  391.     Form1.F1Book1.Write SSName$, F1FileExcel5
  392.  
  393. End Sub
  394.  
  395. Sub SaveFile()
  396.  
  397.     Dim SaveRows%
  398.     
  399.     SaveRows = 1000 ' Save 1000 row worksheet
  400.     
  401.     Call ClearAll
  402.     Form1.Results.Caption = "Save " + Format$(SaveRows, "##,##0") + " Row Worksheet"
  403.     Form1.Refresh
  404.     
  405.     Form1.MousePointer = 11 ' Houseglass mouse pointer
  406.     
  407.     Call Dummy_Data(SaveRows) ' 1,000 rows of dummy data to save
  408.     Form1.Refresh
  409.     
  410.     Form1.MousePointer = 0 ' Normal mouse pointer
  411.     
  412.     Call Time_Operation(Op_Save) ' Time the save
  413.  
  414. End Sub
  415.  
  416. Sub Scroll_VTI()
  417.  
  418.     Dim TheRow%
  419.     
  420.     Form1.F1Book1.TopRow = 1
  421.     For TheRow = 1 To Set_ScrollRows%
  422.        Form1.F1Book1.TopRow = TheRow
  423.     Next TheRow
  424.     
  425.     Form1.F1Book1.Row = Form1.F1Book1.TopRow
  426.     Form1.F1Book1.Col = 1
  427.  
  428. End Sub
  429.  
  430.  
  431. Sub ScrollTime()
  432.  
  433. Call ClearAll
  434.     Form1.Results.Caption = "Scroll " + Format$(Set_ScrollRows, "##,##0") + " Rows"
  435.     Form1.Refresh
  436.     
  437.     ' Fill Worksheet
  438.     
  439.     Form1.MousePointer = 11 ' Hourglass mouse pointer
  440.     
  441.     Call Dummy_Data(Set_ScrollRows) ' Create data to scroll
  442.     Form1.Refresh
  443.     
  444.     Form1.MousePointer = 0 ' Normal mouse pointer
  445.     
  446.     Call Time_Operation(Op_Scroll) ' Time Scroll
  447.  
  448.  
  449. End Sub
  450.  
  451. Sub SortRows()
  452.  
  453.     Dim TheRow%, TheCol%
  454.  
  455.     Call ClearAll ' Clear the worksheet
  456.     Form1.Results.Caption = "Sort " + Format$(Set_SortRows, "##,##0") + " Rows"
  457.     Form1.Refresh
  458.     
  459.     Form1.MousePointer = 11 ' Hourglass mouse pointer
  460.     
  461.     Call Dummy_Data(Set_SortRows) ' Create data to sort
  462.     
  463.     ' Put a set of random numbers in the first column to sort
  464.     
  465.     Form1.F1Book1.AutoRecalc = False
  466.  
  467.     TheCol = 1
  468.     For TheRow = 1 To Set_SortRows
  469.         Form1.F1Book1.NumberRC(TheRow, TheCol) = Int(Rnd(1) * 1000)
  470.     Next TheRow
  471.  
  472.     Form1.F1Book1.AutoRecalc = True
  473.     Form1.Refresh
  474.     
  475.     Form1.MousePointer = 0 ' Normal mouse pointer
  476.     
  477.     Call Time_Operation(Op_Sort) ' Time FO
  478.  
  479. End Sub
  480.  
  481. Sub Time_Operation(Operation As Integer)
  482.  
  483.     Dim StartTime&, EndTime&
  484.     Dim i%
  485.     
  486.     Form1.MousePointer = 11 ' Hourglass mouse pointer
  487.     
  488.     ' Set all timer variables to 0
  489.     Form1.VTSTimeRaw = ""
  490.     Form1.Insuff.Visible = False
  491.     Form1.Refresh
  492.     
  493.     ' Time Formula One
  494.     
  495.     StartTime = GetTickCount() ' Get Starting Time
  496.     
  497.     Select Case Operation
  498.        Case Op_FillF
  499.           Call Fill_VTI(1) ' Formulas
  500.        Case Op_FillN
  501.           Call Fill_VTI(2) ' Numbers
  502.        Case Op_Calc
  503.           Form1.F1Book1.AutoRecalc = True
  504.        Case Op_Scroll
  505.           Call Scroll_VTI
  506.        Case Op_LoadW
  507.           Call Load_VTI
  508.        Case Op_LoadA
  509.            Call Load_AVTI
  510.        Case Op_Save
  511.           Call Save_VTI
  512.        Case Op_Copy
  513.           Form1.F1Book1.SetSelection 1, 1, Set_CopyRows + 1, 5
  514.           Form1.F1Book1.EditCopyDown
  515.        Case Op_Insert
  516.           Call Insert_VTI
  517.        Case Op_Delete
  518.           Call Delete_VTI
  519.        Case Op_Sort
  520.           Form1.F1Book1.Sort3 1, 1, Set_SortRows, 10, True, 1, 2, 3
  521.     End Select
  522.     
  523.      'Get Ending Time
  524.      EndTime = GetTickCount()
  525.     
  526.     ' Calculate time and display
  527.     Global_Time_VTI = (EndTime - StartTime) / 1000
  528.     Form1.VTSTimeRaw = Format$(Global_Time_VTI, "0.00") + " Seconds"
  529.     
  530.     ' If the time was short it may be invalid
  531.     If (EndTime - StartTime) < 200 Then
  532.        Form1.Insuff.Visible = True
  533.     End If
  534.     Form1.Refresh
  535.     
  536.     Form1.MousePointer = 0 ' Normal mouse pointer
  537.     
  538.  
  539. End Sub
  540.  
  541.  
  542.